unit Macros;

interface

uses
  Database, Functions, VarGrabber, AM, refactorings,
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, Menus, Grids,
  ExtCtrls, DB, DBTables, Mask, ComCtrls, DBGrids, PortalGrid, SMDBGrid;

type
  TFormMacros = class(TForm)
    MainMenu1: TMainMenu;
    MenuBasics: TMenuItem;
    F21: TMenuItem;
    PanelFKeys: TPanel;
    BtnF1: TBitBtn;
    a4: TBitBtn;
    Label2: TLabel;
    Bevel10: TBevel;
    LabelLogin: TLabel;
    LabelPanic: TLabel;
    ImagePointer: TImage;
    LabelPanic2: TLabel;
    Status: TLabel;
    LabelLines: TLabel;
    Bevel3: TBevel;
    BtnClear: TBitBtn;
    Script: TMemo;
    BtnUndo: TBitBtn;
    EditCopy: TEdit;
    DSMacros: TDataSource;
    GridMacro: TSMDBGrid;
    procedure BtnDoneClick(Sender: TObject);
    procedure DSMacrosDataChange(Sender: TObject; Field: TField);
    procedure MacroKeyMasterClick(Sender: TObject);
    procedure GridMacroDblClick(Sender: TObject);
    procedure MacroMasterClick(Sender: TObject);
    procedure GridMacroKeyPress(Sender: TObject; var Key: Char);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure BtnHelpClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BtnLoginClick(Sender: TObject);
    procedure BtnClearLoginClick(Sender: TObject);
    procedure BtnUndoClick(Sender: TObject);
    procedure BtnFunctionsClick(Sender: TObject);
    procedure BtnVarClick(Sender: TObject);
    procedure BtnClearClick(Sender: TObject);
    procedure ScriptChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure GridMacroEnter(Sender: TObject);
    procedure BtnAMClick(Sender: TObject);
    procedure GridMacroGetCellParams(Sender: TObject; Field: TField;
      AFont: TFont; var Background: TColor; Highlight: Boolean);
  private
    { Private declarations }
    procedure UpdateLabels;
    procedure UpdateButtons;
    procedure UpdatePointer;
    procedure CheckSave;
    function CountCommands(mac: string): integer;
  public
    { Public declarations }
  end;

var
  FormMacros: TFormMacros;
  bypass: boolean;

implementation
uses
   Variants, DBClient;

{$R *.DFM}

procedure TFormMacros.MacroKeyMasterClick(Sender: TObject);
begin
  CheckSave;
  UpdateButtons;
  Datawell.TableMacros.Locate('Macro', TBitBtn(sender).hint, []);
  DSMacrosDataChange(Sender,nil);
  Script.setfocus;
end;

procedure TFormMacros.GridMacroDblClick(Sender: TObject);
begin
  Script.setfocus;
end;

procedure TFormMacros.MacroMasterClick(Sender: TObject);
begin
  if (TMenuItem(sender).caption = 'Alt+F4') and
    (Datawell.TableOptions.fieldbyname('AltF4ToClose').asboolean) then begin
    messagedlg('Alt-F4 is being used to close the program',mtinformation,[mbok],0);
    exit;
  end;
  if TMenuItem(sender).caption = 'Alt+F6' then exit;
  CheckSave;
  UpdateButtons;
  datawell.TableMacros.Locate('Macro', TMenuItem(sender).Caption, []);
  DSMacrosDataChange(Sender,nil);
  Script.setfocus;
end;

procedure TFormMacros.GridMacroKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then begin
    key:=#0;
    GridMacroDblClick(Sender);
  end;
end;

procedure TFormMacros.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Status.caption:=' '+(sender as TControl).hint;
end;

procedure TFormMacros.BtnHelpClick(Sender: TObject);
begin
  Datawell.Help('macros');
end;

procedure TFormMacros.FormShow(Sender: TObject);
var didfind: boolean;
begin
  with Datawell.TableMacros do begin
    didfind:=false;
    first;
    while not EOF do begin
      if Datawell.TableMacros.fieldbyname('Macro').asstring = Datawell.lastmacro then begin
        didfind:=true;
        break;
      end;
      next;
    end;
    if not didfind then first;
  end;
  UpdateLabels;
  UpdateButtons;
end;

procedure TFormMacros.UpdateLabels;
var
  logmac, linkmac, panmac, panmac2: string;
  i: integer;
begin
  logmac:=Datawell.TableOptions.fieldbyname('LoginMacro').asstring;
  linkmac:='';
  panmac:=Datawell.TableOptions.fieldbyname('PanicMacro').asstring;
  panmac2:=Datawell.TableOptions2.fieldbyname('PanicMacro2').asstring;
  LabelLogin.font.color:=clgray;
  LabelPanic.font.color:=clgray;
  LabelPanic2.font.color:=clgray;
  if logmac <> '' then begin
    LabelLogin.font.color:=clblue;
    for i:=0 to componentcount-1 do begin
      if TBitBtn(components[i]).hint = logmac then begin
        TBitBtn(components[i]).font.color:=clblue;
        TBitBtn(components[i]).font.style:=[fsbold];
        break;
      end;
    end;
    if panmac = logmac then LabelPanic.font.color:=clblue;
    if panmac2 = logmac then LabelPanic2.font.color:=clblue;
  end;
  if (linkmac <> '') and (linkmac <> logmac) then begin
    for i:=0 to componentcount-1 do begin
      if TBitBtn(components[i]).hint = linkmac then begin
        TBitBtn(components[i]).font.color:=clfuchsia;
        TBitBtn(components[i]).font.style:=[fsbold];
        break;
      end;
    end;
    if panmac = linkmac then LabelPanic.font.color:=clfuchsia;
    if panmac2 = linkmac then LabelPanic2.font.color:=clfuchsia;
  end;
  if (panmac <> '') and (panmac <> logmac) and (panmac <> linkmac) then begin
    LabelPanic.font.color:=clgreen;
    for i:=0 to componentcount-1 do begin
      if TBitBtn(components[i]).hint = panmac then begin
        TBitBtn(components[i]).font.color:=clgreen;
        TBitBtn(components[i]).font.style:=[fsbold];
        break;
      end;
    end;
    if panmac2 = panmac then LabelPanic2.font.color:=clgreen;
  end;
  if (panmac2 <> '') and (panmac2 <> logmac) and (panmac2 <> linkmac)
    and (panmac2 <> panmac) then begin
    LabelPanic2.font.color:=clred;
    for i:=0 to componentcount-1 do begin
      if TBitBtn(components[i]).hint = panmac2 then begin
        TBitBtn(components[i]).font.color:=clred;
        TBitBtn(components[i]).font.style:=[fsbold];
        break;
      end;
    end;
  end;
end;

procedure TFormMacros.UpdateButtons;
var
  i: integer;
  hin, logmac, linkmac, panmac, panmac2: string;
begin
  logmac:=Datawell.TableOptions.fieldbyname('LoginMacro').asstring;
  linkmac:='';
  panmac:=Datawell.TableOptions.fieldbyname('PanicMacro').asstring;
  panmac2:=Datawell.TableOptions2.fieldbyname('PanicMacro2').asstring;
  for i:=0 to componentcount-1 do begin
    if TComponent(components[i]).tag <> 1 then continue;
    if TComponent(components[i]).tag > 900 then continue;
    hin:=TBitBtn(components[i]).hint;
    if hin = 'F1' then continue;
    if (hin = 'Alt+F4') and (Datawell.TableOptions.fieldbyname('AltF4ToClose').asboolean) then continue;
    if hin = 'Alt+F6' then continue;
    if hin = logmac then continue;
    if hin = linkmac then continue;
    if hin = panmac then continue;
    if hin = panmac2 then continue;
    if CountCommands(hin) > 0 then begin
      TBitBtn(components[i]).font.style:=[fsbold];
      TBitBtn(components[i]).font.color:=clwhite;
    end
    else begin
      TBitBtn(components[i]).font.style:=[];
      TBitBtn(components[i]).font.color:=clblack;
    end;
  end;
end;

procedure TFormMacros.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_DELETE then begin
    if activecontrol = GridMacro then begin
      BtnClear.click;
      key:=0;
    end;
  end;
end;

procedure TFormMacros.UpdatePointer;
begin
  DrawArrow(TPortalgrid(GridMacro), ImagePointer, 175, 11, 5);
end;

procedure TFormMacros.BtnLoginClick(Sender: TObject);
var mac: string;
begin
  mac:=Datawell.TableMacros.fieldbyname('Macro').asstring;
  if mac = 'Alt+F4' then begin
    if Datawell.TableOptions.fieldbyname('AltF4ToClose').asboolean then begin
      messagedlg('Alt-F4 is being used to close the program',mtinformation,[mbok],0);
      exit;
    end;
  end;
  if mac = 'Alt+F6' then begin
    messagedlg('Alt-F6 Cannot be used as a macro',mtinformation,[mbok],0);
    exit;
  end;
  case TComponent(sender).tag of
    901: begin
         Datawell.TableOptions.edit;
         Datawell.TableOptions.fieldbyname('LoginMacro').asstring:=mac;
         Datawell.TableOptions.post;
       end;
    902: begin
         Datawell.TableOptions.edit;
         Datawell.TableOptions.fieldbyname('PanicMacro').asstring:=mac;
         Datawell.TableOptions.post;
       end;
    903: begin
         Datawell.TableOptions2.edit;
         Datawell.TableOptions2.fieldbyname('PanicMacro2').asstring:=mac;
         Datawell.TableOptions2.post;
       end;
  end;
  GridMacro.repaint;
  UpdateLabels;
  UpdateButtons;
end;

procedure TFormMacros.BtnClearLoginClick(Sender: TObject);
begin
  case TComponent(sender).tag of
    901: begin
         Datawell.TableOptions.edit;
         Datawell.TableOptions.fieldbyname('LoginMacro').asstring:='';
         Datawell.TableOptions.post;
       end;
    902: begin
         Datawell.TableOptions.edit;
         Datawell.TableOptions.fieldbyname('PanicMacro').asstring:='';
         Datawell.TableOptions.post;
       end;
    903: begin
         Datawell.TableOptions2.edit;
         Datawell.TableOptions2.fieldbyname('PanicMacro2').asstring:='';
         Datawell.TableOptions2.post;
       end;
  end;
  GridMacro.repaint;
  UpdateLabels;
  UpdateButtons;
end;

procedure TFormMacros.BtnDoneClick(Sender: TObject);
begin
  CheckSave;
  Datawell.lastmacro:=Datawell.TableMacros.fieldbyname('Macro').asstring;
  close;
end;

procedure TFormMacros.CheckSave;
var
  i: integer;
  didfail: boolean;
begin
  didfail:=false;
  with Datawell.TableMacros do begin
    if fieldbyname('Macro').asstring <> '' then begin
      for i:=0 to Script.lines.count-1 do begin
        if Script.lines[i] = fieldbyname('Macro').asstring then begin
          didfail:=true;
          break;
        end;
      end;
      if didfail then begin
        messagedlg('A macro calling itself would cause recurstion',mtinformation,[mbok],0);
        abort;
      end;
      bypass:=true;
      edit;
      fieldbyname('Script').assign(Script.lines);
      post;
      bypass:=false;
      BtnUndo.enabled:=false;
    end;
  end;
end;

procedure TFormMacros.DSMacrosDataChange(Sender: TObject; Field: TField);
begin
  if not GridMacro.visible then exit;
  if bypass then exit;
  Script.lines.assign(Datawell.TableMacros.fieldbyname('Script'));
  if (Datawell.TableMacros.fieldbyname('Macro').asstring = 'Alt+F6') or
     ((Datawell.TableMacros.fieldbyname('Macro').asstring = 'Alt+F4') and
      (Datawell.TableOptions.fieldbyname('AltF4ToClose').asboolean)) then begin
    Script.readonly:=true;
    Script.color:=clsilver;
  end
  else begin
    Script.readonly:=false;
    Script.color:=clwindow;
  end;
  BtnUndo.enabled:=false;
  UpdatePointer;
end;

procedure TFormMacros.BtnUndoClick(Sender: TObject);
begin
  DSMacrosDataChange(Sender,nil);
  Script.setfocus;
end;

procedure TFormMacros.BtnFunctionsClick(Sender: TObject);
var
  form: TFormFunctions;
  i, po: integer;
begin
  form:=TFormFunctions.create(self);
  form.Setup(Datawell.lastfunction,Script.seltext);
  form.showmodal;
  po:=form.po;
  form.free;
  i:=Script.selstart;
  if po < 1 then begin
    Script.setfocus;
    exit;
  end;
  Script.pastefromclipboard;
  Script.setfocus;
  Script.sellength:=0;
  Script.selstart:=i+po;
end;

procedure TFormMacros.BtnVarClick(Sender: TObject);
var
  formv: TFormVarGrab;
  grab: string;
  i, l: integer;
begin
  formv:=TFormVarGrab.create(self);
  formv.setup;
  formv.showmodal;
  grab:=formv.grab;
  formv.free;
  i:=Script.selstart;
  l:=Script.sellength;
  if grab = '' then begin
    Script.setfocus;
    Script.selstart:=i;
    Script.sellength:=l;
    exit;
  end;
  EditCopy.text:=grab;
  EditCopy.selectall;
  EditCopy.copytoclipboard;
  Script.pastefromclipboard;
  Script.setfocus;
  Script.sellength:=0;
  Script.selstart:=i+length(EditCopy.text);
end;

procedure TFormMacros.BtnClearClick(Sender: TObject);
begin
  if Script.lines.count < 1 then exit;
  Script.lines.clear;
  BtnUndo.enabled:=true;
  Script.setfocus;
end;

procedure TFormMacros.ScriptChange(Sender: TObject);
begin
  LabelLines.caption:='Commands = '+inttostr(Script.lines.count);
  BtnUndo.enabled:=true;
end;

procedure TFormMacros.FormCreate(Sender: TObject);
begin
  bypass:=false;
end;

procedure TFormMacros.GridMacroEnter(Sender: TObject);
begin
  CheckSave;
  UpdateButtons;
end;

procedure TFormMacros.GridMacroGetCellParams(Sender: TObject; Field: TField;
  AFont: TFont; var Background: TColor; Highlight: Boolean);
const
  DISABLED: array[1..4] of string = ('Alt+F4', 'Alt+F6', 'F7', 'Shift+F7');
var
  isspecial: boolean;
  logmac, linkmac, panmac, panmac2: string;
  i: integer;
begin
  logmac:=Datawell.TableOptions.fieldbyname('LoginMacro').asstring;
  linkmac:='';
  panmac:=Datawell.TableOptions.fieldbyname('PanicMacro').asstring;
  panmac2:=Datawell.TableOptions2.fieldbyname('PanicMacro2').asstring;
  if Datawell.TableOptions.fieldbyname('AltF4ToClose').asboolean then
    i := 1
  else i := 2;
  for i := i to high(DISABLED) do
    if field.Value = DISABLED[i] then
    begin
      afont.color:=clsilver;
      afont.style:=[fsitalic];
      background:=clgray;
      exit;
    end;

  isspecial:=false;
  if field.value = logmac then begin
    afont.color:=clblue;
    afont.style:=[fsbold];
    isspecial:=true;
  end;
  if (field.value = linkmac) and (linkmac <> logmac) then begin
    afont.color:=clfuchsia;
    afont.style:=[fsbold];
    isspecial:=true;
  end;
  if (field.value = panmac) and (panmac <> logmac) and (panmac <> linkmac) then begin
    afont.color:=clgreen;
    afont.style:=[fsbold];
    isspecial:=true;
  end;
  if (field.value = panmac2) and (panmac2 <> logmac) and (panmac2 <> linkmac)
    and (panmac2 <> panmac) then begin
    afont.color:=clred;
    afont.style:=[fsbold];
    isspecial:=true;
  end;
  if not isspecial then
  begin
    if (Datawell.TableMacros.fieldbyname('Script') as TBlobField).BlobSize > 0 then
    begin
      afont.color:=clwhite;
      afont.style:=[fsbold];
      isspecial:=true;
    end;
  end;
  if isspecial then
  begin
    if highlight then
      background := clgray
    else background := clsilver;
  end;
end;

function TFormMacros.CountCommands(mac: string): integer;
var
  coms: TStringList;
  script: variant;
begin
  script := Datawell.TableMacros.Lookup('Macro', mac, 'Script');
  if VarIsNull(script) then
    result := 0
  else begin
    coms:=TStringList.create;
    try
       coms.text := script;
       result:=coms.count;
    finally
       coms.free;
    end;
  end;
end;

procedure TFormMacros.BtnAMClick(Sender: TObject);
var
  form: TFormAM;
  grab: string;
  i, l: integer;
begin
  form:=TFormAM.create(self);
  form.avoid:=Datawell.TableMacros.fieldbyname('Macro').asstring;
  form.setup;
  form.showmodal;
  grab:=form.am;
  form.free;
  i:=Script.selstart;
  l:=Script.sellength;
  if grab = '' then begin
    Script.setfocus;
    Script.selstart:=i;
    Script.sellength:=l;
    exit;
  end;
  EditCopy.text:=grab;
  EditCopy.selectall;
  EditCopy.copytoclipboard;
  Script.pastefromclipboard;
  Script.setfocus;
  Script.sellength:=0;
  Script.selstart:=i+length(EditCopy.text);
end;

end.
